$b

#!/usr/bin/perl ############################################################################### # Set Up ############################################################################### %SETUP = ( # General Configurations nam_bbs => "nine ravens", # BBS Title nam_admin => "オルテガ", # Administrator's Name nam_fake => "オﾉﾚ干ガ", # Fake Administrator's Name pwd_admin => "beholds", # Password for Administration pth_self => "http://www.9ravens.com/", # URL Base pth_domain => "9ravens.com", dir_log => "./bbs", # Relative Directory Path of Log pth_header => "./bbs/header.txt", # Relative Path of Header File pth_footer => "./bbs/footer.txt", # Relative Path of Footer File pth_access => "./bbs/access.txt", # Relative Path of Access Log pth_reload => "./bbs/counter.txt", # Relative Path of Reload Counter pth_referer => "./bbs/referer.txt", cfg_html => 0, # Allow HTML Tags cfg_viewsource => 0, # Add view-source Link cfg_sage => 1, # Use 'Sage' Function cfg_access => 300, # Term Length for Recognizing Access (Seconds) # View as Floating Threads cfg_headline => 30, # Featured Headlines cfg_thread => 16, # Featured Threads cfg_article => 8, # Featured Artices for Each Thread # View as Piled Articles cfg_pile => 1, # Use Pile Mode lmt_pile => 300, # Maximum Articles as Current Log pag_pile => 20, # Featured Article for Page # Securitical Limit for Post lmt_size => 8192, # Total Size Limit (Bytes) lmt_subject => 63, # Maximum Size for Subject and Name (Bytes) lmt_line => 40, # Maximum Lines # Storage Function cfg_store => 1, # Use Storage Function ( 0 -> Off, 1 -> Storage, 2 -> Drop Away ) dir_store => "./bbs/old", # Relative Directory Path for Storage of Old Log lmt_store => 500, # Maximum Threads as Current Log # Log Search Function cfg_search => 1, # Show Script Function cfg_script => 0, # Icon Function cfg_icon => 1, # Use Icon Function dir_icon => "./icon", # Relative Directory Path for Icons pth_icon => "index.txt", # Index of Icons # Color Sceme clr_bgcolor => "#224747", # "", # BACKGROUND= clr_text => "#eeeeff", # TEXT= clr_link => "#ddddee", # LINK= clr_vlink => "#bbbbcc", # VLINK= clr_alink => "#bbeedd", # ALINK= clr_quoted => "#ccccdd", # Quoted Parts ); # General Feature for Header $SETUP{'ftr_header'} = <<"__EOL__"; __EOL__ # General Feature for Footer $SETUP{'ftr_footer'} = <<"__EOL__"; __EOL__ # Feartured Clickable Links of Menu ( Able to Add Array Elements by "Label\tURL\tTarget" ) @MENU = ( "フレーム http://www.9ravens.com/index2.html _top", "一行コメント追加 http://www.9ravens.com/addlot.cgi", "磔退避 http://www.9ravens.com/ssbbs.cgi", "磔 http://www.pandora.nu/kandata/imgb/", "家鴨窯 http://www.e-site.jpn.org/e-site/ahiru/ _blank", "JSSDF http://www.jssdf.org/index.html _blank", "retro mania http://www.retro-mania.net/ _blank" ); # Set Timezone $ENV{'TZ'} = "JST-9"; ############################################################################### # Main ############################################################################### if ( $ENV{'REQUEST_METHOD'} eq "POST" ) { # Check Referer -> Exit if ( $ENV{'HTTP_REFERER'} !~ /^$SETUP{'pth_self'}/ ) { &error ( '不適切なリファラー' ); } # Read Variables read ( STDIN, $QUERY_STRING, $ENV{'CONTENT_LENGTH'} ); %FORM = &my_read ( $QUERY_STRING ); $QUERY_STRING = ""; # Check Overflow @ARRAY = ( $FORM{'MESSAGE'} =~ /\r/g ); &error ( 'オーバーフロー' ) if ( $ENV{'CONTENT_LENGTH'} > $SETUP{'lmt_size'} || @ARRAY + 1 > $SETUP{'lmt_line'} || length ( $FORM{'SUBJECT'} ) > $SETUP{'lmt_subject'} || length ( $FORM{'FROM'} ) > $SETUP{'lmt_subject'} ); @ARRAY = (); if ( $FORM{'MESSAGE'} ) { # Erase Article -> Back to Page -> Exit if ( $FORM{'SUBJECT'} eq $SETUP{'pwd_admin'} ) { &my_delete; &mode_float; } # Add Clickable Links &add_link; # Write to Log File &my_write; # Back to Page if ( $SETUP{'cfg_pile'} && $FORM{'MODE'} eq "pile" ) { &mode_pile; } elsif ( $FORM{'MODE'} eq "new" ) { &new_thread; } else { &mode_float; } } else { # Reload Page -> Exit if ( $SETUP{'cfg_pile'} && $FORM{'MODE'} eq "pile" ) { &mode_pile; } elsif ( $FORM{'MODE'} eq "new" ) { &new_thread; } else { &mode_float; } } } else { # Reload Variables %OPTION = &my_read ( $ENV{'QUERY_STRING'} ); # View by Thread -> Exit &mode_thread if ( $OPTION{'thread'} ); # Search Log -> Exit &mode_search if ( $SETUP{'cfg_search'} && $OPTION{'mode'} eq "search" ); # Show Script -> Exit &mode_script if ( $SETUP{'cfg_script'} && $OPTION{'mode'} eq "script" ); # View Page -> Exit if ( $SETUP{'cfg_pile'} && $OPTION{'mode'} eq "pile" ) { &mode_pile; } elsif ( $OPTION{'mode'} eq"new"){ &new_thread; } else { &mode_float; } } # Exit exit; ############################################################################### # Common Subroutins ############################################################################### # Read Variables # Usage: &my_read ( $_[0] => Strings ) # Return: return ( %table ) sub my_read { local ( $a, $b, $c, @array, %table ); $a = $_[0]; @array = split( /&/, $a ); foreach ( @array ) { ( $b, $c ) = split ( /=/, $_ ); $c =~ tr/+/ /; $c =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg; if ( $SETUP{'cfg_html'} ) { $c =~ s//-->/g; } else { $c =~ s/&/&/g; $c =~ s/"/"/g; $c =~ s//>/g; } $table{$b} = $c; } return ( %table ); } # Get Date and Time # Usage: &my_time ( $_[0] => Value, # $_[1] => Mode ( 0 => Return Local Time by Japanese Language # 1 => Return Local Time by Digits # 2 => Transrate Local Time by Japanese Language to Digits ) ) sub my_time { local ( $a, $b, $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdat ); local ( @array ); ( $a, $b ) = @_; if ( $b != 2 ) { ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime ( $a ); if ( $b == 0 ) { @array = ( "日", "月", "火", "水", "木", "金", "土", "日" ); return ( sprintf( "%04d/%02d/%02d(%s)%02d時%02d分%02d秒", $year + 1900, $mon + 1, $mday, @array[$wday], $hour, $min, $sec ) ); } elsif ( $b == 1 ) { $year %= 100; return ( sprintf( "%02d%02d%02d%02d%02d%02d", $year, $mon + 1, $mday, $hour, $min, $sec ) ); } } else { $a =~ /^(\d+)\/(\d+)\/(\d+)$([^$]+)\)(\d+)時(\d+)分(\d+)秒/; ( $year, $mon, $mday, $hour, $min, $sec ) = ( $1, $2, $3, $5, $6, $7 ); return ( sprintf( "%02d%02d%02d%02d%02d%02d", $year, $mon, $mday, $hour, $min, $sec ) ); } } # Count Access # Usage: (No Options) # Return: return ( Reloading Count, Count of Members Access ) sub my_count { local ( $a, $b, $c, $d, $e, $f, $g, $h ); local ( @array ); srand (); $a = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" . "abcdefghijklmnopqrstuvwxyz" . "0123456789./"; for ( 0..1 ) { $b .= substr ( $a, int(rand(64)), 1 ); } $c = crypt ( $ENV{'REMOTE_ADDR'}, $b ); open( OUT, "+< $SETUP{'pth_access'}" ); flock ( OUT, 2 ); @array = ; seek ( OUT, 0, 0 ); foreach ( @array ) { ( $d, $e ) = split( / : /, $_ ); next if ( $e + 0 < time - $SETUP{'cfg_access'} ); $f = substr ( $d, 0, 2 ); next if ( $d eq crypt ( $ENV{'REMOTE_ADDR'}, $f ) ); print OUT; $g++; } $_ = $c . " : " . time . "\n"; print OUT; $g++; truncate ( OUT, tell ( OUT ) ); close ( OUT ); open ( OUT, "+< $SETUP{'pth_reload'}" ); flock ( OUT, 2 ); $h = ; $h++; seek ( OUT, 0, 0 ); print OUT "$h"; close ( OUT ); &record_referer; return ( $h, $g ); } # Get Matched Strings # # Usage: &my_substr ( $_[0] => Object, # $_[1] => Position Where Should Begin, # $_[2] => Position Where Should be Cut ) sub my_substr { local ( $a, $b, $c, $d ); ( $a, $b, $c ) = @_; $d = ( substr ( $a, $c + 1, 2 ) ) ? "..." : ""; $a = substr ( $a, $b, $c ); chop ( $a ) if ( $a =~ /\x8F$/ || $a =~ tr/\x8E\xA1-\xFE// % 2 ); $a .= $d; return ( $a ); } # Read Directory and Sort Files # # Usage: (No Options) # Return: return ( @array => List Sorted ) sub my_readdir { local ( $a, $b, $c, $i ); local ( @array ); opendir ( DIR, $SETUP{'dir_log'} ); @array = readdir ( DIR ); closedir ( DIR ); for ( $i = 0; $array[$i]; $i++ ) { $c = ( $array[$i] =~ /^\d+\.(.+)/ ) ? ( stat ( "$SETUP{'dir_log'}/$array[$i]" ) )[9] : " "; #スレッドの最終更新時刻を参照 $c = ( length ( $c ) == 9 ) ? "0" . $c : $c; $array[$i] = "$c,$array[$i]"; } @array = sort { $b cmp $a; } @array; @array = &my_store ( @array ) if ( $SETUP{'cfg_store'} && $#array >= $SETUP{'lmt_store'} ); return ( @array ); } ############################################################################### # Loopy Work ############################################################################### # Print Lines # Usage: &print_line ( $_[0] => File Handle, # $_[1] => Key of Thread, # $_[2] => Strings to Print ) sub print_line { local ( $a, $b, $c ); ( $a, $b, $c ) = @_; $c =~ s%%%g; if ( $SETUP{'cfg_pile'} && $OPTION{'mode'} eq "pile" ) { $c =~ s%^(\d+)\.%$1\.\n%; } else { $c =~ s%^(\d+)\.%$1\.\n%; } $c =~ s%投稿者：%\n投稿者：%; $c =~ s%投稿日：%\n投稿日：%; $c =~ s%

%\n
%; $c =~ s%
%\n%g; print $a "$c\n"; return; } # Print Input Form # Usage: &print_form ( $_[0] => File Handle, # $_[1] => Value of FROM, # $_[2] => Value of MAIL, # $_[3] => Value of SUBJECT, # $_[4] => Value of MESSAGE, # $_[5] => List of Hidden Inputs, # $_[6] => Value of SUBMIT Button, # $_[7] => Snip Counts, # $_[8] => Clickable Link for VIEW BY THREAD, # $_[9] => Clickable Link for VIEW BY PAGE ) sub print_form { local ( $a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, @array ); ( $a, $b, $c, $d, $e, $f, $g, $h, $i, $j ) = @_; print $a <<"__EOL__";

投稿者

メール

題名

内容（要改行、URL自動リンク）
$e __EOL__ @array = split ( /&/, $f ); foreach ( @array ) { ( $k, $l ) = split ( /=/, $_ ); print $a "\n"; } print $a <<"__EOL__";

$h$i $j

__EOL__ return; } ############################################################################### # Arrange Log File ############################################################################### # Add Clickable Links # Usage: (No Options) sub add_link { local ( $a ); $FORM{'MESSAGE'} .= "\n"; $FORM{'MESSAGE'} =~ s/\x0D\x0A|\x0D|\x0A/\n/g; if ( $SETUP{'cfg_viewsource'} ) { $FORM{'MESSAGE'} =~ s/([^=^\"]|^)(https?|ftp|gopher|telnet|whois|news)(\:[\w\.\~\-\/\?\&\+\=\:\@\%\;\[\]\#]+)/$1$2$3<\/A> (view-source)<\/FONT><\/A>/g; } else { $FORM{'MESSAGE'} =~ s/([^=^\"]|^)(https?|ftp|gopher|telnet|whois|news)(\:[\w\.\~\-\/\?\&\+\=\:\@\%\;\[\]\#]+)/$1$2$3<\/A>/g; } ##2006 07 Dec if ( $FORM{'MESSAGE'} =~ /\[url/i ){ exit(0); } ## ##2006 11 Dec if ( $FORM{'MESSAGE'} =~ /\$&<\/FONT>/g if ( $SETUP{'clr_quoted'} ); $FORM{'MESSAGE'} =~ s/>>(\d+)\-(\d+)/$&<\/A>/g; $FORM{'MESSAGE'} =~ s/>>(\d+)([^\-\d])/>>$1<\/A>$2/g; $FORM{'MESSAGE'} =~ s/\n/
/g; $FORM{'MESSAGE'} =~ s/(
)+$//g; if ( $FORM{'FROM'} && $SETUP{'cfg_icon'} ) { open ( IN, "$SETUP{'dir_icon'}/$SETUP{'pth_icon'}" ); read ( IN, $a, ( -s "$SETUP{'dir_icon'}/$SETUP{'pth_icon'}" ) ); close ( IN ); if ( $a =~ /^$FORM{'FROM'}\s+(.+)/ ) { ## $FORM{'MESSAGE'} = "
" . $FORM{'MESSAGE'} . "
"; }else{ $FORM{'MESSAGE'} = "
" . $FORM{'MESSAGE'} . "
"; } } else { $FORM{'MESSAGE'} = "
" . $FORM{'MESSAGE'} . "
"; } $FORM{'FROM'} =~ s/$SETUP{'nam_admin'}/$SETUP{'nam_fake'}/; $FORM{'FROM'} =~ s/$SETUP{'pwd_admin'}/$SETUP{'nam_admin'}/; return; } # Write to Thread File # Usage: (No Options) sub my_write { local ( $a, $b, $c, $d, $i, $e, $f, $g, $h, $i, $j, $k, $l, $m ); local ( @array ); $a = &my_time ( time, 1 ); $b = &my_time ( time, 0 ); if ( $FORM{'SUBJECT'} eq "＞" . $FORM{'ARTICLE_TO'} && ! $FORM{'HANDLE_TO'} ) { $FORM{'SUBJECT'} = "＞" . $FORM{'ARTICLE_TO'} . ""; } #form check #2006 07 Dec #2007 28 Jan if ( $FORM{'MAIL'} =~ /@/ ){ exit(0); } if ( $FORM{'MAIL'} =~ /%40/ ){ exit(0); } if ( $FORM{'MAIL'} =~ /http/ ){ exit(0); } ## if ( $FORM{'MAIL'} ) { $c = ( $FORM{'MAIL'} =~ /^http:/ ) ? "$FORM{'FROM'}" : "$FORM{'FROM'}"; } else { $c = $FORM{'FROM'}; } $d = <<"__EOL__"; $FORM{'SUBJECT'} 投稿者：$c 投稿日：$b
$FORM{'MESSAGE'}
__EOL__ $d =~ s/\n//g; if ( $FORM{'INDEX'} eq "new" ) { &error ( '題名がありません' ) unless ( $FORM{'SUBJECT'} ); @array = &my_readdir; for ( $i = 0; $array[$i] && $i < $SETUP{'cfg_thread'}; $i++ ) { ( $k, $l ) = split ( /,/, $array[$i] ); open ( IN, "$SETUP{'dir_log'}/$l" ); $_ = ; close ( IN ); m%(.*) .+(.*) .+
(.+)
%; $FORM{'SUBJECT'} eq $1 && $c eq $2 && $FORM{'MESSAGE'} eq $3 && &error ( '多重投稿' ); } $a++ while ( -f "$SETUP{'dir_log'}/$a.dat" ); $d =~ s/ $SETUP{'dir_log'}/$a.dat" ); flock ( OUT, 2 ); print OUT "1.$d\n"; close ( OUT ); $f = 1; #追加0309Feb } elsif ($FORM{'INDEX'} eq "freelog"){ open ( OUT, "+< $SETUP{'dir_log'}/freelog.dat" ) || &error ( 'スレッドがありません' ); flock ( OUT, 2 ); if ( $SETUP{'cfg_sage'} && $FORM{'MAIL'} eq "sage" || $FORM{'MAIL'} eq "hide" ) { #hideと記入で積み上げ非表示かつsage $e = ( stat ( "$SETUP{'dir_log'}/freelog.dat" ) )[9]; } while ( ) { last unless ( /^(\d+)\./ || /Articles -->(\d+)\./ ); $f = $1; $g = tell ( OUT ); $h = $_; $j = $_ if ( $f == 1 ); } $h =~ m%(.*) .+(.*) .+
(.+)
%; $FORM{'SUBJECT'} eq $1 && $c eq $2 && $FORM{'MESSAGE'} eq $3 && &error ( '多重投稿' ); seek ( OUT, $g, 0 ); $f++; print OUT "$f.$d\n"; $m = $f; $m = " " . $m while ( length ( $m ) < 4 ); $j =~ s///; seek ( OUT, 0, 0 ); print OUT "$j"; close ( OUT ); if ( $SETUP{'cfg_sage'} && $FORM{'MAIL'} eq "sage" || $FORM{'MAIL'} eq "hide" ) { #hideと記入で積み上げ非表示かつsage utime ( $e, $e, "$SETUP{'dir_log'}/freelog.dat" ); return; } $a = $FORM{'INDEX'}; # return;# 積み上げに書き込まないでreturn(21Feb) #追加ここまで } else { open ( OUT, "+< $SETUP{'dir_log'}/$FORM{'INDEX'}.dat" ) || &error ( 'スレッドがありません' ); flock ( OUT, 2 ); if ( $SETUP{'cfg_sage'} && $FORM{'MAIL'} eq "sage" || $FORM{'MAIL'} eq "hide" ) { #hideと記入で積み上げ非表示かつsage $e = ( stat ( "$SETUP{'dir_log'}/$FORM{'INDEX'}.dat" ) )[9]; } while ( ) { last unless ( /^(\d+)\./ || /Articles -->(\d+)\./ ); $f = $1; $g = tell ( OUT ); $h = $_; $j = $_ if ( $f == 1 ); } $h =~ m%(.*) .+(.*) .+
(.+)
%; $FORM{'SUBJECT'} eq $1 && $c eq $2 && $FORM{'MESSAGE'} eq $3 && &error ( '多重投稿' ); seek ( OUT, $g, 0 ); $f++; print OUT "$f.$d\n"; $m = $f; $m = " " . $m while ( length ( $m ) < 4 ); $j =~ s///; seek ( OUT, 0, 0 ); print OUT "$j"; close ( OUT ); if ( $SETUP{'cfg_sage'} && $FORM{'MAIL'} eq "sage" || $FORM{'MAIL'} eq "hide" ) { #hideと記入で積み上げ非表示かつsage utime ( $e, $e, "$SETUP{'dir_log'}/$FORM{'INDEX'}.dat" ); } $a = $FORM{'INDEX'}; } if ($FORM{'INDEX'} eq "freelog") { #freelogへのレスは積み上げに記録しない # &write_pile ( $a, $f, $d ) ; }elsif ($FORM{'MAIL'} eq "0" || $FORM{'MAIL'} eq "hide"){#メール欄に0、hideで積み上げログに書き込まない return; }elsif( $SETUP{'cfg_pile'} ){ &write_pilec ( $a, $f, $d ) ; } return; } # Write to Piled Log sub write_pile { local ( $a, $f, $b, $c, $subject, $articles, @array ); ( $a, $f, $b ) = @_; ##insert thread title open ( IN, "$SETUP{'dir_log'}/$a.dat" ); $_ = ; close ( IN ); ( $subject, $articles ) = &get_subject ( $_, 0, 48 ); #/insert thread title $b =~ s%(\d+)%%; $b =~ s%
%

　■　◆　%; $b =~ s%%

$FORM{'REFERENCE'}%; $c = "" . $b . '' . $subject . '' . "\n"; open ( OUT, "+< $SETUP{'dir_log'}/bbs.dat" ) || open ( OUT, "> $SETUP{'dir_log'}/bbs.dat" ) || return; flock ( OUT, 2 ); @array = ; seek ( OUT, 0, 0 ); unshift ( @array, $c ); for ( $i = 0; $i < $SETUP{'lmt_pile'} && $array[$i]; $i++ ) { print OUT "$array[$i]"; } truncate ( OUT, tell ( OUT ) ); close ( OUT ); return; } ###freelog to pile sub write_pilec { local ( $a, $f, $b, $c, $subject, $articles, @array ); ( $a, $f, $b ) = @_; ##insert thread title open ( IN, "$SETUP{'dir_log'}/$a.dat" ); $_ = ; close ( IN ); ( $subject, $articles ) = &get_subject ( $_, 0, 48 ); #/insert thread title $b =~ s%(\d+)%%; $b =~ s%%　■　◆　%; $b =~ s%%

$FORM{'REFERENCE'}%; $c = "" . '

' . $b . '' . $subject . '

' . '' . "\n"; open ( OUT, "+< $SETUP{'dir_log'}/bbs.dat" ) || open ( OUT, "> $SETUP{'dir_log'}/bbs.dat" ) || return; flock ( OUT, 2 ); @array = ; seek ( OUT, 0, 0 ); unshift ( @array, $c ); for ( $i = 0; $i < $SETUP{'lmt_pile'} && $array[$i]; $i++ ) { print OUT "$array[$i]"; } truncate ( OUT, tell ( OUT ) ); close ( OUT ); return; } ###/freelog to pile # drop old to Storage sub my_store { local ( $a, $b, $c, $i, $cnt, $pos ); local ( @array ); @array = @_; for ( $i = $SETUP{'lmt_store'}; $array[$i]; $i++ ) { ( $a, $b ) = split ( /,/, $array[$i] ); $c = ( $b =~ /^(\d+)\.dat/ ) ? $1 : ""; next if ( ! $c || -f "$SETUP{'dir_store'}/$c.html" ); if ( ! $c || -f "$SETUP{'dir_store'}/$c.html" ) { next; } elsif ( $SETUP{'cfg_store'} == 2 ) { unlink ( "$SETUP{'dir_log'}/$b" ); $array[$i] = ""; next; } unless ( open ( OUT, "+< $SETUP{'dir_store'}/index.html" ) ) { open ( OUT, "> $SETUP{'dir_store'}/index.html" ) || return; flock ( OUT, 2 ); seek ( OUT, 0, 0 ); &print_header ( "OUT", $SETUP{'nam_bbs'} . " 過去ログ一覧" ); print OUT <<"__EOL__"; $SETUP{'nam_bbs'} 過去ログ一覧

__EOL__ } else { seek ( OUT, 0, 0 ); while ( ) { last if ( /^/ ); $cnt = ( /(\d+)<\/A>\./ ) ? $2 : ""; $pos = tell ( OUT ); } seek ( OUT, $pos, 0 ); } $cnt++; &log_index ( "OUT", $cnt, $b ); print OUT <<"__EOL__";


#	題名 / 内容	投稿者	記事	最終更新日

現在、$cnt件のスレッドがあります。

$SETUP{'ftr_footer'} __EOL__ close ( OUT ); open ( OUT, "> $SETUP{'dir_store'}/$c.html" ) || next; flock ( OUT, 2 ); open ( IN, "$SETUP{'dir_log'}/$b" ); read ( IN, $d, ( -s "$SETUP{'dir_log'}/$b" ) ); close ( IN ); $e = ( $d =~ /([^\<]*) <\/B>/ ) ? $1 : ""; &print_header ( "OUT", $e ); print OUT "$d\n"; print OUT "$SETUP{'ftr_footer'}\n"; close ( OUT ); unlink ( "$SETUP{'dir_log'}/$b" ); $array[$i] = ""; } return ( @array ); } ############################################################################### # Get Subject ############################################################################### # Make Subject sub get_subject { local ( $a, $b, $articles, $subject, $comment ); ( $_, $a, $b ) = @_; $articles = ( /(\d+) Articles -->/ ) ? $1 : ""; $subject = ( /([^\<]*) <\/B><\/FONT>/ ) ? $1 : ""; return ( &my_substr ( $subject, $a, $b ), $articles ); } # Make Log Index sub log_index { local ( $out, $cnt, $thread, $date, $articles, $subject, $from, $comment ); ( $out, $cnt, $thread ) = @_; $thread =~ s/\.dat//; open ( IN, "$SETUP{'dir_log'}/$thread.dat" ); $_ = ; close ( IN ); $date = ( stat ( "$SETUP{'dir_log'}/$thread.dat" ) )[9]; $date = &my_time ( $date, 0 ); $from = ( /投稿者：(.*) <\/B>/ ) ? $1 : ""; $from =~ s/<([^\>])*>//g; $from = &my_substr ( $from, 0, 12 ); ( $subject, $articles ) = &get_subject ( $_, 0, 48 ); print $out ""; if ( $out eq "STDOUT" ) { print $out ""; } else { print $out ""; } print $out "$cnt. $subject $from $articles $date\n"; return; } ############################################################################### # Print Header and Footer ############################################################################### # Print Content Header # # &print_header ( $_[0] => Title of HTML Document ) sub print_header { local ( $a, $b, $c, $d ); ( $a, $b ) = @_; $c = "Content-type: text/html\n\n" if ( $a eq "STDOUT" ); $d = " $b $SETUP{'ftr_header'} $d __EOL__ return; } # Print Page Header sub page_header { local ( $a, $b, $c, $d, $e, $f, $i ); ( $i ) = @_; ( $a, $b ) = &my_count; &print_header ( "STDOUT", $SETUP{'nam_bbs'} ); open ( IN, "$SETUP{'pth_header'}" ); print STDOUT while ; close ( IN ); if ( $i ) { $c = ( $FORM{'MODE'} eq "pile" || $OPTION{'mode'} eq "pile" ) ? "MODE=pile&" : ""; &print_form ( "STDOUT", "", "", "", "", $c . "INDEX=$i", "投稿／リロード", "", "", "" ); } print STDOUT <<"__EOL__";
通算リロード : $a | 現在の参加者 : $b人 ($SETUP{'cfg_access'}秒以内) __EOL__ print STDOUT "\n"; print STDOUT "
\n"; print STDOUT "|"; if ( $SETUP{'cfg_pile'} ) { if ( $FORM{'MODE'} eq "pile" || $OPTION{'mode'} eq "pile" ) { print STDOUT " フロート | 新規スレッド作成 |"; } else { print STDOUT " 積み上げ | 新規スレッド作成 |"; } } print STDOUT " ログ検索 |" if ( $SETUP{'cfg_search'} ); print STDOUT " 過去ログ |" if ( $SETUP{'cfg_store'} && $SETUP{'dir_store'} ); print STDOUT " スクリプト |" if ( $SETUP{'cfg_script'} ); foreach ( @MENU ) { s/\t\t/\t/g; ( $d, $e, $f ) = split ( /\t/, $_ ); $f = " TARGET=\"$f\"" if ( $f ); print STDOUT " $d |"; } print STDOUT "\n"; print STDOUT "\n\n"; return; } ####### make new thread ###### sub new_thread { local ( $a, $b, $c, $d, $e, $f, $i ); ( $i ) = @_; ( $a, $b ) = &my_count; &page_header ( 'new' ); return; } ###### # Print Page Footer sub page_footer { local ( $a, $b, $c, $d, $e, $f ); ( $a, $b ) = @_; if ( $SETUP{'cfg_pile'} && ( $FORM{'MODE'} eq "pile" || $OPTION{'mode'} eq "pile" ) ) { $c = "記事"; $d = ""; $e = ""; $e = "
$d$e
\n"; $f = $SETUP{'pag_pile'}; } else { $c = "スレッド"; $f = $SETUP{'cfg_thread'}; } $a++; unless ( $b < $a ) { print STDOUT <<"__EOL__";

以上は、現在登録されている新着$a番目から$b番目の$cです。
__EOL__ } elsif ( $FORM{'TIME'} ) { $file_lot = "./lot.dat"; $file_name = "./name.dat"; open(FILE, "$file_lot"); @naiyou = ; close(FILE); $rand1 = @naiyou; open(FILE, "$file_name"); @namae = ; close(FILE); $rand2 = @namae; srand(time + $$); $mai1 = int(rand($rand1)); $mai2 = int(rand($rand2)); print ""; print "$naiyou[$mai1]　　　$namae[$mai2] " } if ( $b - $a < $f - 1 && ( ! $FORM{'TIME'} || ( $FORM{'TIME'} && $b < $a ) ) ) { print STDOUT <<"__EOL__"; 新規投稿$cはありません。 __EOL__ } else { print STDOUT <<"__EOL__"; $e $d $d __EOL__ } open ( IN, "$SETUP{'pth_footer'}" ); while ( ) { print; } close ( IN ); print STDOUT "$SETUP{'ftr_footer'}\n"; exit; } ############################################################################### # Selective View Mode ############################################################################### # View by Thread sub mode_thread { local ( $a, $b, $c, $d, $e, $f, $i ); local ( @array, @array2 ); open ( IN, "$SETUP{'dir_log'}/$OPTION{'thread'}.dat" ) || &error ( 'スレッドがありません' ); @array = ; close ( IN ); $a = ( $array[0] =~ /([^\<]*) <\/B><\/FONT>/) ? $1 : ""; &print_header ( "STDOUT", $a ); $b = ( $OPTION{'st'} ) ? $OPTION{'st'} - 1 : 0; $c = ( $OPTION{'to'} ) ? $OPTION{'to'} - 1 : $#array; if ( $OPTION{'st'} || $OPTION{'to'} ) { if ( $SETUP{'cfg_pile'} && $OPTION{'mode'} eq "pile" ) { $d = "スレッドを全部読む"; } else { $d = "スレッドを全部読む"; } } $f = "MODE=pile&" if ( $OPTION{'mode'} eq "pile" ); $f .= "INDEX=$OPTION{'thread'}"; for ( $i = $b; $array[$i] && $i <= $c; $i++ ) { &print_line ( "STDOUT", $OPTION{'thread'}, $array[$i] ); } if ( $OPTION{'to'} && $b == $c ) { if ( $array[$c] =~ /投稿者：(.+) <\/B>/ ) { $e = $1; $e =~ s/<([^\>]*)>//g; $f .= "&HANDLE_TO=" . $e; } else { $e = $OPTION{'to'}; } $f .= "&ARTICLE_TO=" . $OPTION{'to'}; $e = "＞" . $e; $f .= ( $array[$c] =~ /<\/B>投稿日：([^\<]+)/ ) ? "&REFERENCE=参考：" . $1 : ""; $_ = ( $array[$c] =~ /(.*)<\/PRE>/ ) ? $1 : ""; @array2 = split ( / /, $_ ); foreach ( @array2 ) { s/>$view-source$]*)>//g; next unless ( $_ ); next if ( /^> > / ); $g .= "> $_\n"; } if ( $g ) { $g .= "\n"; } } &print_form ( "STDOUT", "", "", $e, $g, $f, "レス／リロード", "", $d, "掲示板に戻る" ); print STDOUT "\n\n"; print STDOUT "$SETUP{'ftr_footer'}\n"; exit; } # View as Floating Threads sub mode_float { local ( $a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k, $l, $m, $n, $o ); local ( @array, @array2 ); &page_header ( 'freelog' );#変更(new=>freelog) print STDOUT <<"__EOL__"; __EOL__ $FORM{'PAGE'} = 0 unless ( $FORM{'PAGE'} ); @array = &my_readdir; #freelogは常にヘッドライン先頭に表示 print STDOUT "0.freelog \n"; #ここまで for ( $i = 0; $i < $SETUP{'cfg_headline'} && $array[$i]; $i++ ) { $f = $i + 1; ( $c, $d ) = split ( /,/, $array[$i] ); last if $c eq " "; open ( IN, "$SETUP{'dir_log'}/$d" ); $_ = ; close ( IN ); $d =~ s/\.dat//; ( $e, $g ) = &get_subject ( $_, 0, 24 ); $e .= "(" . $g . ")"; $g = ( $i >= $FORM{'PAGE'} && $i < $FORM{'PAGE'} + $SETUP{'cfg_thread'} ) ? "" : ""; print STDOUT "$g$f.$e \n"; ( $c, $d, $e, $g ) = (); } print <<"__EOL__"; 以上は、現在登録されている新着順1番目から$f番目までのスレッドのヘッドラインです。 __EOL__ ###freelogを冒頭に表示 print <<"__EOL__"; __EOL__ open ( IN, "$SETUP{'dir_log'}/freelog.dat" ); $_ = ; &print_line ( "STDOUT", freelog, $_ ); for ( $h = 0; ; $h++ ) { $array2[$h % $SETUP{'cfg_article'}] = $_; } close ( IN ); $k = ( $h < $SETUP{'cfg_article'} ) ? 0 : $h - $SETUP{'cfg_article'}; $o = $k + 9; $l = ( $k > 0 ) ? " このスレッドは$k個の記事が省略されています:" : ""; if ($k < 42){$n = 1;}else{ $n = $k - 41;} for ( $m = $k; $m < $h; $m++ ) { &print_line ( "STDOUT", freelog, $array2[$m % $SETUP{'cfg_article'}] ); } &print_form( "STDOUT", "", "", "", "", "INDEX=" . freelog, "レス／リロード", $l, " Read All ", " Last 50 " ); ### for ( $i = $FORM{'PAGE'}; $i < $FORM{'PAGE'} + 16 && $array[$i]; $i++ ) { ( $c, $d ) = split ( /,/, $array[$i] ); last if $c eq " "; $f = $i + 1; print <<"__EOL__"; __EOL__ open ( IN, "$SETUP{'dir_log'}/$d" ); $_ = ; $d =~ s/\.dat//; &print_line ( "STDOUT", $d, $_ ); for ( $h = 0; ; $h++ ) { $array2[$h % $SETUP{'cfg_article'}] = $_; } close ( IN ); $k = ( $h < $SETUP{'cfg_article'} ) ? 0 : $h - $SETUP{'cfg_article'}; $o = $k + 9; $l = ( $k > 0 ) ? " このスレッドは$k個の記事が省略されています:" : ""; if ($k < 42){$n = 1;}else{ $n = $k - 41;} for ( $m = $k; $m < $h; $m++ ) { &print_line ( "STDOUT", $d, $array2[$m % $SETUP{'cfg_article'}] ); } &print_form( "STDOUT", "", "", "", "", "INDEX=" . $d, "レス／リロード", $l, " Read All ", " Last 50 " ); print <<"__EOL__"; __EOL__ ( $c, $d, $f, $h, $k, $l, $m ) = (); } &page_footer ( $FORM{'PAGE'}, $i ); exit; } # View as Piled Articles sub mode_pile { local ( $a, $b, $c, $i, $id, @array ); open ( IN, "$SETUP{'dir_log'}/bbs.dat" ); flock ( IN, 2 ); for ( $i = 0; ; $i++ ) { if ( $FORM{'TIME'} ) { if ( /^/ && $1 > $FORM{'TIME'} ) { unshift ( @array, $_ ); } else { last; } } else { last if ( $i > $FORM{'PAGE'} + $SETUP{'pag_pile'} - 1 ); push ( @array, $_ ) if ( $i >= $FORM{'PAGE'} ); } } close ( IN ); &page_header ( freelog ); $c = time; print STDOUT <<"__EOL__"; __EOL__ foreach ( @array ) { # s/\d+\.//; # $id = $1; print STDOUT "\n"; &print_line ( "STDOUT", "", $_ ); } &page_footer ( $FORM{'PAGE'}, $i ); exit; } ############################################################################### # Special Purpose ############################################################################### # Search Log sub mode_search { local ( $a, $b, $c, $d, $e, $f, $g, $h, $i, $j, $k ); local ( @array, @array2 ); $a = ( $OPTION{'keyword'} ) ? "$SETUP{'nam_bbs'} ログ検索結果" : "$SETUP{'nam_bbs'} ログ一覧"; &print_header ( "STDOUT", $a ); print STDOUT <<"__EOL__"; $a キーワード __EOL__ $OPTION{'keyword'} =~ s/　/ /g; $OPTION{'keyword'} =~ s/ / /g; @array = split ( / /, $OPTION{'keyword'} ); @array2 = &my_readdir; thread: for ( $i = 0; $array2[$i]; $i++ ) { ( $b, $c ) = split ( /,/, $array2[$i] ); last if ( $b eq " " ); open ( IN, "$SETUP{'dir_log'}/$c" ); read ( IN, $d, ( -s "$SETUP{'dir_log'}/$c" ) ); close ( IN ); foreach ( @array ) { next thread if ( $d !~ /$_/ ); } $d = ""; $e++; &log_index ( "STDOUT", $e, $c ); ( $b, $c, $d, $f, $g, $h, $j, $k ) = (); } print " # 題名 / 内容投稿者記事最終更新日 \n"; print "\n"; if ( $OPTION{'keyword'} ) { print STDOUT "キーワード"; foreach ( @array ) { print STDOUT "「$_」"; } print STDOUT "について検索しました。 \n"; if ( $e ) { print STDOUT "$e件のスレッドにヒットしました。 \n"; } else { print STDOUT "該当するスレッドがありません。 \n"; } } else { if ( $e ) { print STDOUT "現在、$e件のスレッドがあります。 \n"; } else { print STDOUT "スレッドがありません。 \n"; } } print STDOUT "掲示板に戻る\n"; print STDOUT "\n"; print STDOUT "\n"; print STDOUT "$SETUP{'ftr_footer'}\n"; exit; } # Show Script sub mode_script { print STDOUT "Content-type: text/plain\n"; print STDOUT "\n"; open ( IN, "./bbs.cgi" ); while ( ) { s/pwd_admin(\s+)=> "([^\"]*)"/\pwd_admin\1=> "\*\*\*\*\*\*"/g; print; } close ( IN ); print STDOUT "\n"; print STDOUT "# スクリプトはここまでです。これ以降は消して下さい。\n"; exit; } #truncate freelog sub tr_log{ } # Erase Article sub my_delete { local ( $a, $b ); local ( @array ); if ( $FORM{'MESSAGE'} =~ /ALL/ ) { unlink ( "$SETUP{'dir_log'}/$FORM{'INDEX'}.dat" ); &mode_float; } $a = ( $FORM{'MESSAGE'} =~ /(\d+)/ ) ? $1 : ""; open ( OUT, "+< $SETUP{'dir_log'}/$FORM{'INDEX'}.dat" ); flock ( OUT, 2 ); @array = ; $b = ( $a == 1 && $array[0] =~ // ) ? $& : ""; $array[$a - 1] = <<"__EOL__"; $b$a. 投稿者：投稿日： __EOL__ $array[$a - 1] =~ s/\n//g; $array[$a - 1] .= "\n"; seek ( OUT, 0, 0 ); foreach ( @array ) { print OUT; } truncate ( OUT, tell ( OUT ) ); close ( OUT ); &mode_float; } # Error Messages # &error ( $_[0] => Cause ) sub error { local ( $a ); $_ = $_[0]; $a = $SETUP{'nam_bbs'} . " エラー - ". $_; &print_header( "STDOUT", $a ); if ( /不適切なリファラー/ ) { print STDOUT "不適切なリファラーからの投稿です。 \n"; print STDOUT "$SETUP{'nam_bbs'}へ \n"; } if ( /多重投稿/ ) { print STDOUT "多重投稿です。 \n"; print STDOUT "戻る \n"; } if ( /オーバーフロー/ ) { print STDOUT "投稿サイズが大きすぎます。 \n"; print STDOUT "$SETUP{'lmt_size'}バイト以内に編集しなおして下さい。 \n"; } if ( /題名がありません/ ) { print STDOUT "スレッドには題名をつけて下さい。 \n"; } if ( /スレッドがありません/ ) { print STDOUT "書き込もうとしたスレッドがありません。 \n"; } if ( /不適切なリファラー/ || /オーバーフロー/ || /題名がありません/ || /スレッドがありません/ ) { print STDOUT "戻る（投稿内容は消えます） \n"; print STDOUT " \n"; $FORM{'MESSAGE'} =~ s/\r\n/\r/g; &print_form ( "STDOUT", $FORM{'FROM'}, $FORM{'MAIL'}, $FORM{'SUBJECT'}, $FORM{'MESSAGE'}, "INDEX=" . $FORM{'INDEX'}, "投稿", "", "", "" ); } print STDOUT "$SETUP{'ftr_footer'}\n"; exit; } sub record_referer { if ( $ENV{'HTTP_REFERER'} && $ENV{'HTTP_REFERER'} !~ /$SETUP{'pth_domain'}/ ) { open ( OUT, ">> $SETUP{'pth_referer'}" ) || open ( OUT, "> $SETUP{'pth_referer'}" ) || return; flock ( OUT, 2 ); $_ = &my_time ( time, 0 ); print OUT "$_\t$ENV{'HTTP_REFERER'}\n"; close ( OUT ); return; }else{ return; } }

投稿者
メール
題名
内容（要改行、URL自動リンク） $e __EOL__ @array = split ( /&/, $f ); foreach ( @array ) { ( $k, $l ) = split ( /=/, $_ ); print $a "\n"; } print $a <<"__EOL__";
$h$i $j